home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir42
/
c7105.zip
/
CHILD.TPX
< prev
next >
Wrap
Text File
|
1994-03-02
|
24KB
|
466 lines
#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
#!│ CHILD.TPX │Version: 3007.105│
#!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
#!│Structure Type Description │
#!│──────────────────── ───────── ─────────────────────────────────────────│
#!│Child PROCEDURE Update a batch of child records │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.102 Repaired CHILD Procedure │
#!│3007.105 Repaired CHILD Procedure │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#PROCEDURE(Child,'Update child records from a parent'),SCREEN,PULLDOWN
#!
#!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐
#!│ Child │Version: 3007.105│
#!├──────────────────────────────┤Description├─────────────┴─────────────────┤
#!│ The Child template scrolls child records from a file on the screen │
#!│ and allows updating the records on the same screen. A parent │
#!│ file must be identified and a valid parent record must be in memory │
#!│ when this procedure is called. │
#!│ │
#!│ The QUEUE will contain all children records for a particular │
#!│ Parent record. Changes to the children records are made to the │
#!│ QUEUE and are only written to disk upon completion of the OK │
#!│ button. The update process is framed within a logged transaction. │
#!│ The child file must use a file driver which supports transaction │
#!│ processing in order to use this template. │
#!│ │
#!│ The Child template's screen will contain a scrolling listbox │
#!│ With Add, Change, Delete, Ok and Cancel pushbuttons and a fixed │
#!│ field entry area with Save and Exit Buttons. │
#!│ │
#!│ The Child template does not support autonumbering of keys. │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.102 Repaired the FillQueues ROUTINE to work correctly with Multi- │
#!│ Part Keys. │
#!│3007.105 Completed support for PullDowns │
#!│ Moved the #SET of %FirstNonFixedRow from it's previous place │
#!│ inside an #IF structure, to right after the #SET of %FixRows │
#!│ Added #INSERT of StandardHeader │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#DISPLAY('')
#INSERT(%StandardHeader)
#PROTOTYPE('')
#PROMPT('First Upd&ate Field',FIELD),%FirstUpdateField
#PROMPT('Parent F&ile',FILE),%ParentFile
#PROMPT('Exit on &Null Parent',CHECK),%NullParentExit
#PROMPT('Upd&ate Parent on OK',CHECK),%PutParent
#INSERT(%SetChildSymbols)
%Procedure PROCEDURE
#INSERT(%FileControl)
#FIX(%File,%Primary)
RecordQueue QUEUE,PRE(SAV)
Line STRING(%ScreenFieldQueueSize) #<! Line to be scrolled
SaveRecord LIKE(%FilePre:Record),PRE(SAV)
SkipRecord BYTE
#FIX(%Key,%PrimaryKey)
#SET(%FirstField, %Null)
#SET(%SortString,%Null)
#FOR(%KeyField)
#FIX(%Field,%KeyField)
#IF(%FirstField = %Null)
#SET(%FirstField, %KeyField)
#SET(%FirstFieldSequence, %KeyFieldSequence)
#ENDIF
#IF(%KeyFieldSequence <> 'DESCENDING')
#SET(%SortString, (CLIP(LEFT(%SortString)) & ',+SAV:' & %FieldID))
#ELSE
#SET(%SortString, (CLIP(LEFT(%SortString)) & ',-SAV:' & %FieldID))
#ENDIF
#ENDFOR
RecordPosition STRING(256)
#FOR(%Field)
#IF(%FieldType = 'MEMO')
#SET(%MemoField,%FieldID)
%FieldID STRING(SIZE(%Field)) #<! Restore the Memos
#ENDIF
#ENDFOR
. #<!End Queue structure
FirstPage BYTE(1) ! Page display variable
EntryMode BYTE(0) ! Toggles for entry mode
ScrollMode EQUATE(1) ! ScrollMode or
UpdateMode EQUATE(2) ! UpdateMode
DRecs SHORT ! Number of Child records
QRecs SHORT ! Number of QUEUE records
I BYTE ! QUEUE record pointer
ChildAction BYTE(0) ! Update mode
NoMoreFields BYTE(0) ! No more fields
TransactionError BYTE(0) ! Transaction Error
RecordEntryOne BYTE(0) ! Starting record in QUEUE
%LocalData
%ScreenStructure
#IF(%PullDown)
%PulldownStructure
SAV::PullDownOpened BYTE(0)
#ENDIF
#EMBED('Data Section')
CODE
#EMBED('Setup Procedure')
#INSERT(%NullParentCheck) #!Return if blank parent
#INSERT(%FileControl)
#INSERT(%HoldParentRecord) #!Hold the parent record
OPEN(SCREEN) !Open the screen
#EMBED('Setup Screen')
#IF(%Pulldown) #!If a Pulldown exists
OPEN(%Pulldown) #<!Open the Pulldown
SAV::PullDownOpened = True
#EMBED('Setup Pulldown') #! Embedded Source Code
#ENDIF
DO EnterScrollMode !Select Scrolling mode
DO FillQueues !Fill the Queues
DRecs = RECORDS(RecordQueue) !Save the number of children
#FIX(%File,%Primary)
DISPLAY !Show the listbox
LOOP
#INSERT(%GenerateFormulas) #!Generate all formulas
#EMBED('Top of Accept Loop')
CASE SELECTED() !Jump to setup routine
OF NoMoreFields
SELECT(?Save)
DO EnterScrollMode ! Switch modes
#INSERT(%ScreenSetupRoutines)
END !End CASE
ACCEPT !Accept user input
CASE KEYCODE()
#FOR(%HotKey)
OF %HotKey #<!User defined HotKey
%HotKeyProc #<!HotKey Procedure
#ENDFOR
END
IF EntryMode = ScrollMode !If processing the ScrollMode
IF RECORDS(RecordQueue) = %FixRows #<! If deleted last record.
DISABLE(?Change) ! Disable the change button
DISABLE(?Delete) ! Disable the delete button
END ! End IF
CASE FIELD() ! Jump to edit routine
OF ?List ! Process the List box
GET(RecordQueue,CHOICE()) #<! Get the Record Data
IF ERRORCODE() THEN CYCLE. ! Cycle if no records
#FIX(%File,%Primary)
%FilePre:Record = SAV:SaveRecord #<! Fill the fields
#FOR(%Field)
#IF(%FieldType = 'MEMO')
#SET(%MemoField,%FieldID)
%Field = SAV:%FieldID #<! Restore the Memos
#ENDIF
#ENDFOR
#INSERT(%GetChildSecondary)
DISPLAY ! and re-display
IF KEYCODE() = MouseLeft2 ! On Mouse double click
PRESS(EnterKey) ! Press the EnterKey
END ! End IF
OF ?Insert ! Process the Insert Button
#FIX(%File,%Primary)
ChildAction = AddRecord ! Set to adding a record
#INSERT(%ClearFileFields) #<! Clear the record for entry
#INSERT(%GetChildSecondary)
DO EnterUpdateMode ! Switch to update mode
#IF(%InitRoutine) #<!Field(s) initial value
DO InitializeFields !Initial values from dictionary
#ENDIF
OF ?Change ! Process the Change Button
ChildAction = ChangeRecord ! Set to Changing a record
DO EnterUpdateMode ! Switch modes
OF ?Delete ! Process the Delete Button
ChildAction = DeleteRecord ! Set to Deleting a record
DELETE(RecordQueue) ! Delete Record Queue Entry
#INSERT(%ClearFileFields) #<! Clear the record for entry
DISPLAY ! Redisplay the list box
IF RECORDS(RecordQueue) = %FixRows #<! If deleted last record.
DISABLE(?Change) ! Disable the change button
DISABLE(?Delete) ! Disable the delete button
SELECT(?Insert) ! Select the insert button
ELSE ! Else
SELECT(?List) ! Select the list box
END ! End IF
ChildAction = 0 ! Reset the Action
CYCLE ! Cycle to accept input
OF ?Ok ! Process the Ok Button
QRecs = RECORDS(RecordQueue) ! Save the queue record count
#FIX(%File, %Primary)
#INSERT(%ClearFileFields) #<!Clear the record buffer
TransactionError = 0 !Clear Transaction error
#FIX(%File, %ParentFile)
#FIX(%Relation,%Primary)
#IF(%RelationType = '1:MANY')
#FOR(%RelationKeyField)
#IF(%RelationKeyFieldLink)
%RelationKeyField = %RelationKeyFieldLink #<!Assign linking field value
#ENDIF
#ENDFOR
#ENDIF
SET(%RelationKey,%RelationKey) #<!Set to the matching record
LOGOUT(2,%Primary) #<!Enable transaction logging
IF ERRORCODE() = BadTranErr !If transaction error occurs
#INSERT(%BadTrxPrimaryMsg)
SELECT(?Ok) ! Reselect the Ok button
CYCLE ! Cycle to ACCEPT input
END !End IF
#INSERT(%UpdateChildRecords)
IF TransactionError !If transaction error occurs
#INSERT(%BadTrxChildMsg)
ROLLBACK ! Rollback the changes.
SELECT(?List,I) ! Reselect the List box
PRESS(EnterKey) ! Setup to change record
CYCLE ! Cycle to ACCEPT input
ELSE !Else
COMMIT ! Commit the changes to disk
END !End IF
#INSERT(%PutParentFile)
DO ProcedureReturn ! Break to Return to Caller
OF ?Cancel !Process the Cancel Button
DO ProcedureReturn ! Break to Return to Caller
END !End CASE
ELSE ! Else if update mode
#INSERT(%GetChildSecondary)
DISPLAY ! Display the new record
CASE FIELD() !
#FOR(%ScreenField)
#IF(%ScreenField='?OK')
#ELSIF(%ScreenField='?Cancel')
#ELSIF(%ScreenField='?Save')
OF ?Save ! Process the Save Button
#FIX(%ScreenField,'?Save') #! Set current active to ?Save
#IF(%ScreenFieldEdit) #! Check for Field Edits
%ScreenFieldEdit
#ENDIF
CASE ChildAction ! Adding or Changing?
OF AddRecord ! When adding a new record.
#INSERT(%FillQueueFields)
ADD(RecordQueue %SortString) #<! Add to the sorted queue
ChildAction = 0 ! Reset the Action value
OF ChangeRecord ! When changing a record
#INSERT(%FillQueueFields)
PUT(RecordQueue %SortString) #<! Add to the queue
ChildAction = 0 ! Reset the Action value
END ! Case
SELECT(1) !Start with the first field
SELECT !and cycle non-stop
CYCLE !restart main process loop
#ELSIF(%ScreenField='?Exit')
OF ?Exit ! Process the Exit Button
#FIX(%ScreenField,'?Exit') #! Set current active to ?Exit
#IF(%ScreenFieldEdit) #! Check for Field Edits
%ScreenFieldEdit
#ENDIF
DO EnterScrollMode ! Switch modes
END
#ELSE
#INSERT(%ScreenEditRoutines)
#ENDIF
#ENDFOR
END ! End IF
CASE FIELD()
#FOR(%PulldownField)
#IF(%PulldownFieldProc <> %NULL)
OF %PulldownField #<!For a selected menu item
%PulldownFieldProc #<!Call the procedure
#ENDIF
#ENDFOR
END !End CASE for Pulldowns
END !End LOOP
!─────────────────────────────────────────────────────────────────────────────
ProcedureReturn ROUTINE
#EMBED('Prior to Return')
#IF(%Pulldown) #!If a Pulldown exists
IF SAV::PullDownOpened
CLOSE(%Pulldown) #<!Open the Pulldown
END
#ENDIF
#IF(%SharedFiles)
RELEASE(%ParentFile) #<!Release held parent record
#ENDIF
FREE(RecordQueue) !Free the QUEUE memory
#EMBED('Before Closing Screen')
#EMBED('Before Closing Files')
#INSERT(%FileControl)
DO EndOfProcedureEmbed
RETURN
!─────────────────────────────────────────────────────────────────────────────
EndOfProcedureEmbed ROUTINE
#EMBED('End of Procedure')
#EMBED('Custom Routines')
!─────────────────────────────────────────────────────────────────────────────
#INSERT(%ChildInitFields)
EnterScrollMode ROUTINE !Switch screen mode routine
DISABLE(1,FIELDS()) ! Disable listbox and buttons
ENABLE(?List) ! Enable the list box
ENABLE(?Insert, ?Cancel) ! Enable the Buttons
IF RECORDS(RecordQueue) = %FixRows #<! If no records to scroll
IF EntryMode ! If not before FillQueues
DISABLE(?Change) ! Disable the change button
DISABLE(?Delete) ! Disable the delete button
SELECT(?Insert) ! Select the insert button
END ! End IF
ELSE ! Else
SELECT(?List) ! Select the list box
END ! End IF
EntryMode = ScrollMode ! Switch to scroll mode
#EMBED('Enter Scroll Mode Routine')
EnterUpdateMode ROUTINE
EntryMode = UpdateMode !Switch screen mode routine
DISABLE(1,FIELDS()) ! Disable listbox and buttons
ENABLE(?%FirstUpdateField, ?Exit) #<! Enable the entry fields
Select(?%FirstUpdateField) #<! Select the first entry field
#EMBED('Enter Update Mode Routine')
FillQueues ROUTINE
FREE(RecordQueue) #<!Clear the Record queue
#SET(%FixRows, '0')
#SET(%ListField,'?List')
#FIX(%ScreenField,%ListField)
#FOR(%ScreenFieldFix)
#SET(%FixRows, (%FixRows + 1))
SAV:Line = %ScreenFieldFix #<!Add list box fixed fields
ADD(RecordQueue %SortString) #<! Add to the sorted queue
DISPLAY(?List) #<!Blank the listbox
#ENDFOR
#SET(%FirstNonFixedRecord,(%FixRows+1))
#FIX(%File, %Primary)
#INSERT(%ClearFileFields) #<!Clear the Child record
#FIX(%File, %ParentFile)
#FIX(%Relation,%Primary)
#IF(%RelationType = '1:MANY')
#FOR(%RelationKeyField)
#IF(%RelationKeyFieldLink)
%RelationKeyField = %RelationKeyFieldLink #<!Assign linking field value
#ENDIF
#ENDFOR
#ENDIF
SET(%RelationKey,%RelationKey) #<!Set to keyed order
LOOP !Get all selected records
NEXT(%Primary) #<!Get the next record.
IF ERRORCODE() THEN BREAK. !Quit if an error occurs
#INSERT(%GetChildSecondary)
#FIX(%File,%Primary)
#FIX(%Key,%PrimaryKey)
#IF(%ChildRelationField) #!If using a Range
#SET(%FieldCounter,%Null)
#FOR(%RelationKeyField)
#IF(%RelationKeyFieldLink)
#SET(%FieldCounter,(%FieldCounter+1))
#ENDIF
#ENDFOR
#SET(%IfWritten,%Null)
#FOR(%RelationKeyField)
#IF(%RelationKeyFieldLink)
#IF(%FieldCounter = '1')
#IF(%IfWritten)
OR %RelationKeyFieldLink <> %RelationKeyField #<!If not in Range
#ELSE
IF %RelationKeyFieldLink <> %RelationKeyField #<!If not in Range
#ENDIF
#BREAK
#ELSE
#IF(%IfWritten)
OR %RelationKeyFieldLink <> %RelationKeyField |#<!If not in Range
#ELSE
IF %RelationKeyFieldLink <> %RelationKeyField |#<!If not in Range
#ENDIF
#ENDIF
#SET(%IfWritten,'TRUE')
#SET(%FieldCounter,(%FieldCounter-1))
#ENDIF
#ENDFOR
IF RECORDS(RecordQueue) <> %FixRows #<! If records were added
GET(RecordQueue,%FirstNonFixedRecord) #<! Get first non-fixed row
RESET(%RelationKey,SAV:RecordPosition) #<! Reset to the last entry
NEXT(%Primary) #<! Reread the last entry
BREAK #<! Break out of the Loop
ELSE ! Else no children found
#INSERT(%ClearFileFields) #<! Clear the record
BREAK #<! Break out of the Loop
END ! End IF
END !End IF
#ENDIF
#IF(%RecordFilterFormula)
IF ~(%RecordFilterFormula) #<!If Filter condition not met
CYCLE ! Try another record
END !End IF
#ELSE
#FOR(%Formula)
#IF(UPPER(%FormulaClass) = 'FILTER')
#IF(%FormulaType <> 'COMPUTED')
IF ~(%FormulaCondition) #<!If Filter condition not met
CYCLE ! Try another record
END !End IF
#ELSE
IF ~(%FormulaComputation) #<!If Filter condition not met
CYCLE ! Try another record
END !End IF
#ENDIF
#ENDIF
#ENDFOR
#ENDIF
#FOR(%Formula)
#IF(UPPER(%FormulaClass) = 'LIST')
#INSERT(%GenerateFormula) #!Generate LIST formulas
#ENDIF
#ENDFOR
#FIX(%File,%Primary)
#SET(%ListField,'?LIST')
#FIX(%ScreenField,%ListField)
SAV:Line = %ScreenFieldExpression #<! Fill the DisplayQueue line
SAV:SaveRecord = %FilePre:Record ! Save the record data
SAV:RecordPosition = POSITION(%RelationKey) ! Save the record position
#FOR(%Field)
#IF(%FieldType = 'MEMO')
#SET(%MemoField,%FieldID)
SAV:%FieldID = %Field #<! Restore the Memos
#ENDIF
#ENDFOR
ADD(RecordQueue %SortString) #<! Add to the sorted queue
IF ERRORCODE() THEN BREAK. ! Quit out if error
IF FirstPage ! If page 1
IF RECORDS(RecordQueue) = ROWS(?List) ! If we have a full screen
FirstPage = 0 ! turn off the page flag
END ! End IF
DISPLAY(?List) ! Display page 1
END ! End IF
END !End LOOP
IF RECORDS(RecordQueue) = %FixRows #<!If the queue is empty
IF RECORDS(%Primary) #<! If file is not empty
IF ?List <> %FirstEntryField #<! And list is not first
SELECT(1) ! Select the first field
ELSE ! Else
DISABLE(1,FIELDS()) ! Disable all fields
ENABLE(?Insert) ! Enable the Insert and
ENABLE(?Cancel) ! the cancel buttons
SELECT(?Insert) ! Select the Insert Button
END ! End IF
ELSE ! Else the file is empty
DISABLE(1,FIELDS()) ! Disable all fields
ENABLE(?Insert) ! Enable the Insert and
ENABLE(?Cancel) ! the cancel buttons
SELECT(?Insert) ! Select the Insert Button
END ! End IF
ELSE !Else records exist
GET(RecordQueue,%FirstNonFixedRecord) #<! Get first non-fixed row
RESET(%RelationKey,SAV:RecordPosition) #<! Reset to the last entry
NEXT(%Primary) #<! Reread the last entry
#INSERT(%GetChildSecondary)
END !End IF
DISPLAY
#!
#CHAIN('Report.tpx')